home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / CUGUK / PC_LIBS / C044.ZIP / VIDEO7.ZIP / SVGADEMO.PAS < prev    next >
Pascal/Delphi Source File  |  1989-08-14  |  4KB  |  125 lines
  1. { Super VGA  Demo Program           }
  2. {   Thomas Design                   }
  3. {   August 11, 1989                 }
  4.  
  5. uses
  6.   Graph,crt,
  7.   VGAEXTRA,                            { dacpalette(..) and flashmodes }
  8.   VID7DET;
  9. var
  10.   Gd, Gm : integer;
  11.   DAC    : RGB;                        { DAC is a byte aligned array of char }
  12.  
  13. {------------- Hue Saturation & Intensity  TO  rgb -----------------}
  14. procedure hsi2rgb(h,s,i: real; var Rvalue,Gvalue,Bvalue : integer);
  15.   var
  16.       t: real;
  17.       rv,gv,bv: real;
  18.   begin { procedure hsi2rgb }
  19.     t:=2*pi*h;
  20.     rv:=1+s*sin(t-2*pi/3);
  21.     gv:=1+s*sin(t);
  22.     bv:=1+s*sin(t+2*pi/3);
  23.     t:=63.999*i/2;
  24.     Rvalue:=trunc(rv*t);
  25.     Gvalue:=trunc(gv*t);
  26.     Bvalue:=trunc(bv*t);
  27. end;
  28.  
  29. {------------- Load the inital color palette -----------------------}
  30. procedure LoadPalette(HueStep: real;SatStep : real;IntenStep : real);
  31. var index : integer;
  32.     h,s,i : real;
  33.     h1,s1,i1 : real;
  34.     r,g,b : integer;
  35. begin
  36.     h1 := 1.0 / HueStep;
  37.     h  := 0;                           { start with hue value of zero }
  38.     s  := 1.00;
  39.     i  := 1.00;
  40.     for index := 1 to 256 do begin
  41.       hsi2rgb(h,s,i,R,G,B);            { compute RGB values using HSI }
  42.       DAC[index][0] := R;              { load each RGB value into the array }
  43.       DAC[index][1] := G;
  44.       DAC[index][2] := B;
  45.       h := h + h1;
  46.       i := i - IntenStep;
  47.       s := s - SatStep;
  48.     end;
  49.     Dac[0][0] := 0;                    { Insure the background stays black }
  50.     Dac[0][1] := 0;
  51.     Dac[0][2] := 0;
  52.     dacpalette(DAC);
  53. end;
  54.  
  55. {------------ Initialize the graphics system -----------------------}
  56. procedure InitGraphics;                { setup the SuperVGA driver }
  57.   var count : integer;
  58.       Error : integer;
  59. begin
  60.   gd := InstallUserDriver('VID256',@_DetectVID256);  { must say   gd := Install...  to work }
  61.   gd := DETECT;
  62.   InitGraph(gd, gm ,'');               { use the default graphics mode }
  63.   Error := GraphResult;
  64.   if Error <> grOK then                { if SVGA driver not available, error! }
  65.   begin
  66.      Writeln('Graphics error: ', GraphErrorMsg(Error));
  67.      Halt(1);
  68.   end;
  69.   LoadPalette(64,0,0);
  70. end;
  71.  
  72. {------------ use circles in graphics demo -------------------------}
  73. procedure CirclePlay;
  74.   var
  75.      FillColor                  : integer;
  76.      MaxX, MaxY                 : integer;
  77.      MaxRadius                  : integer;
  78.      Xcenter,Ycenter            : integer;
  79.      Ballx,Bally                : integer;
  80.      Index                      : byte;
  81.      xincrement,yincrement      : integer;
  82.      Testx,Testy                : integer;
  83.      MirrorX,MirrorY            : integer;
  84. begin
  85.   Maxradius  := getmaxx div 40;
  86.   MaxX       := getmaxx;
  87.   MaxY       := getmaxy;
  88.   Xcenter    := MaxX div 2;
  89.   Ycenter    := MaxY div 2;
  90.   Ballx      := Xcenter;
  91.   Bally      := Ycenter;
  92.   xincrement := -Maxradius;
  93.   yincrement := -Maxradius;
  94.   randomize;
  95.   Index  := 1;
  96.   repeat
  97.       SetColor(Index);
  98.       SetFillStyle(SOLIDFILL, Index);
  99.       FillEllipse(Ballx, Bally,Maxradius, Maxradius);
  100.       Testx := Ballx - Xcenter;
  101.       Testy := Bally - Ycenter;
  102.       MirrorX := -Testx + Xcenter;
  103.       FillEllipse(MirrorX,Bally,Maxradius, Maxradius);
  104.       MirrorY := -Testy + Ycenter;
  105.       FillEllipse(Ballx,MirrorY,Maxradius, Maxradius);
  106.       FillEllipse(MirrorX,MirrorY,Maxradius, Maxradius);
  107.       Ballx := Ballx + xincrement;
  108.       Bally := Bally + yincrement;
  109.       If ((Ballx <= 0) or (Ballx >= MaxX)) then xincrement := xincrement * -1;
  110.       If ((Bally <= 0) or (Bally >= MaxY)) then yincrement := yincrement * -1;
  111.       inc(index);
  112.       if (Index = 0) then begin
  113.           inc(Index);
  114.           LoadPalette(random(128)+64,random/100,random/100);
  115.       end;
  116.   until KeyPressed;
  117. end;
  118.  
  119. begin
  120.     InitGraphics;
  121.     CirclePlay;
  122.     restorecrtmode;
  123. end.
  124.  
  125.